home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Source Code / C / Applications / Moscow ML 1.31 / source code / mosml / src / mosmllib / Splaytree.sml < prev    next >
Encoding:
Text File  |  1996-07-03  |  4.2 KB  |  105 lines  |  [TEXT/R*ch]
  1. (* Splaytree -- modified for Moscow ML from 
  2.  * SML/NJ library which is 
  3.  * COPYRIGHT (c) 1993 by AT&T Bell Laboratories.  
  4.  * See file mosml/copyrght/copyrght.att for details.
  5.  *
  6.  * Splay tree structure.
  7.  *)
  8.  
  9. datatype 'a splay = 
  10.     SplayObj of {value : 'a,
  11.          right : 'a splay,
  12.          left : 'a splay}
  13.   | SplayNil
  14.  
  15. datatype 'a ans_t = No | Eq of 'a | Lt of 'a | Gt of 'a
  16.  
  17. fun splay (compf, root) = let
  18.     fun adj SplayNil = (No,SplayNil,SplayNil)
  19.       | adj (arg as SplayObj{value,left,right}) =
  20.           (case compf value of
  21.             EQUAL => (Eq value, left, right)
  22.           | GREATER =>
  23.               (case left of
  24.                 SplayNil => (Gt value,SplayNil,right)
  25.               | SplayObj{value=value',left=left',right=right'} =>
  26.                   (case compf value' of
  27.                     EQUAL => (Eq value',left',
  28.                                 SplayObj{value=value,left=right',right=right})
  29.                   | GREATER =>
  30.                       (case left' of 
  31.                         SplayNil => (Gt value',left',SplayObj{value=value,left=right',right=right})
  32.                       | _ => 
  33.                         let val (V,L,R) = adj left'
  34.                             val rchild = SplayObj{value=value,left=right',right=right}
  35.                         in
  36.                           (V,L,SplayObj{value=value',left=R,right=rchild})
  37.                         end
  38.                       ) (* end case *)
  39.                   | _ =>
  40.                       (case right' of 
  41.                         SplayNil => (Lt value',left',SplayObj{value=value,left=right',right=right})
  42.                       | _ =>
  43.                         let val (V,L,R) = adj right'
  44.                              val rchild = SplayObj{value=value,left=R,right=right}
  45.                              val lchild = SplayObj{value=value',left=left',right=L}
  46.                         in
  47.                           (V,lchild,rchild)
  48.                         end
  49.                       ) (* end case *)
  50.                   ) (* end case *)
  51.               ) (* end case *)
  52.           | _ =>
  53.              (case right of
  54.                SplayNil => (Lt value,left,SplayNil)
  55.              | SplayObj{value=value',left=left',right=right'} =>
  56.                  (case compf value' of
  57.                    EQUAL =>
  58.                      (Eq value',SplayObj{value=value,left=left,right=left'},right')
  59.                  | LESS =>
  60.                      (case right' of
  61.                        SplayNil => (Lt value',SplayObj{value=value,left=left,right=left'},right')
  62.                      | _ =>
  63.                        let val (V,L,R) = adj right'
  64.                            val lchild = SplayObj{value=value,left=left,right=left'}
  65.                        in
  66.                          (V,SplayObj{value=value',left=lchild,right=L},R)
  67.                        end
  68.                      ) (* end case *)
  69.                  | _ =>
  70.                      (case left' of
  71.                        SplayNil => (Gt value',SplayObj{value=value,left=left,right=left'},right')
  72.                      | _ =>
  73.                        let val (V,L,R) = adj left'
  74.                            val rchild = SplayObj{value=value',left=R,right=right'}
  75.                            val lchild = SplayObj{value=value,left=left,right=L}
  76.                        in
  77.                          (V,lchild,rchild)
  78.                        end
  79.                      ) (* end case *)
  80.                  ) (* end case *)
  81.              ) (* end case *)
  82.           ) (* end case *)
  83.   in
  84.     case adj root of
  85.       (No,_,_) => (GREATER,SplayNil)
  86.     | (Eq v,l,r) => (EQUAL,SplayObj{value=v,left=l,right=r})
  87.     | (Lt v,l,r) => (LESS,SplayObj{value=v,left=l,right=r})
  88.     | (Gt v,l,r) => (GREATER,SplayObj{value=v,left=l,right=r})
  89.   end
  90.  
  91. fun lrotate SplayNil = SplayNil
  92.   | lrotate (arg as SplayObj{value,left,right=SplayNil}) = arg
  93.   | lrotate (SplayObj{value,left,right=SplayObj{value=v,left=l,right=r}}) = 
  94.     lrotate (SplayObj{value=v,
  95.               left=SplayObj{value=value,left=left,right=l},
  96.               right=r})
  97.  
  98. fun join (SplayNil, SplayNil) = SplayNil
  99.   | join (SplayNil, t       ) = t
  100.   | join (t,        SplayNil) = t
  101.   | join (l,r) =
  102.     case lrotate l of
  103.         SplayNil => r      (* impossible as l is not SplayNil *)
  104.       | SplayObj{value,left,right} => SplayObj{value=value,left=left,right=r}
  105.